Sub Uniquedata()
    Dim Cel As Range, Res
    Set d = CreateObject("Scripting.Dictionary")
    For Each Cel In Range("a1:a11")
        If Cel <> "" Then
            If Not d.exists(Cel.Value) Then
                d.Add Cel.Value, Cel.Value
            End If
        End If
    Next
    Res = d.Items
    iKey = d.Keys
    For i = 0 To d.Count - 1
        Cells(i + 1, 3) = Res(i) & "-" & iKey(i)
    Next i
End Sub

Sub Uniquedata1()
Dim myList As New Collection, Cel As Range, itm, i As Integer
    On Error Resume Next
   For Each Cel In Range("a1:a11")
   myList.Add Cel.Value, CStr(Cel.Value)
   Next
   On Error GoTo 0
   i = 1
   For Each itm In myList
     Cells(i, 3) = itm
     i = i + 1
   Next
End Sub
